SUBROUTINE SUPHEC(KULOUT)

! (C) Copyright 1995- ECMWF.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.

!**** *SUPHEC - INITIALISES PHYSICAL CONSTANTS OF UNCERTAIN VALUE.
!               WITHIN THE E.C.M.W.F. PHYSICS PACKAGE

!     PURPOSE.
!     --------

!          THIS ROUTINE SETS THE VALUES FOR THE PHYSICAL CONSTANTS USED
!     IN THE PARAMETERIZATION ROUTINES WHENEVER THESE VALUES ARE NOT
!     KNOWN WELL ENOUGH TO FORBID ANY TUNING OR WHENEVER THEY ARE
!     SUBJECT TO AN ARBITRARY CHOICE OF THE MODELLER. THESE CONSTANTS
!     ARE DISTRIBUTED IN COMMON DECKS *YOEXXXX* WHERE XXXX CORRESPONDS
!     TO THE INDIVIDUAL PHYSICAL PARAMETRIZATION

!**   INTERFACE.
!     ----------

!          *SUPHEC* IS CALLED FROM *SUPHY*

!     METHOD.
!     -------

!          NONE.

!     EXTERNALS.
!     ----------

!          *SUVDFS*, *SUVDF*, *SUVEG*, *SUSOIL*, *SURDI*


!     REFERENCE.
!     ----------

!          SEE PHYSICAL ROUTINES FOR AN EXACT DEFINITION OF THE
!     CONSTANTS.

!     AUTHOR.
!     -------
!          J.-J. MORCRETTE  E.C.M.W.F.    91/06/15  ADAPTATION TO I.F.S.

!     MODIFICATIONS
!     -------------
!          J.-F. Mahfouf E.C.M.W.F.       95/03/01 (For 1D surface scheme)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        P.Viterbo     24-May-2004 surf library
!        P. Viterbo   ECMWF   03-12-2004  Include user-defined RTHRFRTI
!        Y. Takaya    ECMWF   07-10-2008  Include flag for ocean ML
!        S. Boussetta/G.Balsamo May 2009  Add switch for variable LAI: LELAIV
!        E. Dutra             16-11-2009  snow 2009 cleaning
!        S. Boussetta/G.Balsamo May 2010  Include CTESSEL switch LECTESSEL
!        G.Balsamo/S. Boussetta June 2011 Include switch LEAGS (for modularity CO2&Evap)
!        R. Hogan             14-01-2019  Changed LE4ALB to NALBEDOSCHEME
!        A. Agusti-Panareda   Nov 2020    Include variable air CO2 switch LEAIRCO2COUP in photosynthesis
!        A. Agusti-Panareda   Jul 2021    Include LEFARQUHAR switch fro photosynthesis
!        J. McNorton          24-08-2022  Urban tile
!        V. Huijnen           31-10-2023  Support for online BVOC emissions
!        I. Ayan-Miguez       Oct 2023    Include reading of surface global parameters
!     ----------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB,   JPRD
USE YOMHOOK   ,ONLY : LHOOK    ,DR_HOOK, JPHOOK
USE YOS_NAMPARS1, ONLY : TESURF
USE YOMCST   , ONLY : RD       ,RV       ,RCPD     ,RCPV     ,&
            &RLVTT    ,RLSTT   ,RLMLT    ,RTT      ,RATM     ,&
            &RESTT    ,RPI     ,R        ,RDAY     ,RSIGMA
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
            &R4IES    ,R5LES    ,R5IES   ,RVTMP2   ,RHOH2O   ,&
            &R5ALVCP  ,R5ALSCP  ,RALVDCP ,RALSDCP  ,RALFDCP  ,&
            &RTWAT    ,RTBER    ,RTICE,  RTICECU, RTWAT_RTICE_R, RTWAT_RTICECU_R
USE YOERAD   , ONLY : NSW      ,NTSW     ,LONEWSW  ,LCCNL    ,&
            &LCCNO    ,RCCNSEA ,RCCNLND, NLWEMISS
USE YOMDPHY  , ONLY : NCSS     ,NTILES , YDSURF , NCSNEC
USE YOEPHY   , ONLY : RTHRFRTI, LEVGEN   ,LESSRO   ,LESN09   ,&
            &NALBEDOSCHEME, NEMISSSCHEME,NFLAKEV, LEOCWA, LEOCCO, LEOCSA, LEOCLA,&
            &LEFLAKE,LEURBAN,LELAIV ,LECTESSEL, LEAGS, LEAIRCO2COUP, LEFARQUHAR, RLAIINT, & 
            &NCWS,LWCOU,LWCOU2W,LWCOUHMF, LBVOC_EMIS,&
            &LEOCML,LESNML,LESNICE, LEWARMSTART, LECOLDSTART, NSNMLWS, RALFMINPSN, &
            &NBVOC_EMIS, BVOC_NAMES, NBVOC_EMIS_DEFAULT, DELTA_DAY_LAI_EMIS_BVOC, TMP_SURF
            
USE YOEOPTSURF, ONLY : RVR0VT, RVCMAX25, RHUMREL, RA1, RB1, RG0, RGM25, RE_VCMAX, RE_JMAX
USE YOELW    , ONLY : NSIL     ,TSTAND   ,XP
USE YOESW    , ONLY : RSUN
USE YOESOIL1S, ONLY : RDAW 
USE YOMCT01S  , ONLY  : LSCMEC   ,LROUGH   ,REXTZ0M  ,REXTZ0H
USE YOMLUN1S  , ONLY  : NULNAM
USE YOEVDF    , ONLY  : RVDIFTS
USE YOS_SURF, ONLY : TSURF, GET_SURF
USE MPL_MODULE, ONLY : MPL_BARRIER
USE RDNML_PARAMS, ONLY : RDNML_SNOW, RDNML_SOIL, RDNML_VEG, RDNML_AGS, RDNML_FLAKE, RDNML_EXC, RDNML_URB

IMPLICIT NONE

INTEGER(KIND=JPIM) :: KULOUT,NCOM,I
REAL(KIND=JPRB)    :: RCIMIN
LOGICAL :: LEOCMTKE

TYPE(TSURF), POINTER :: YSURF
LOGICAL :: LEWBCHECK,LEWBCHECKAbort,LESNCHECK,LESNCHECKAbort,LESKTI5,&
           & LESKTI8,LEWBSOILFIX,LESOILCOND,LESNWBCON,LEROLAKE

REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

#include "susurf.h"
#include "surf_inq.h"
#include "suvdfs.intfb.h"
#include "suvdf.intfb.h"
#include "surdi.intfb.h"
#include "surdi1s.intfb.h"
#include "sulwn.intfb.h"
#include "suswn.intfb.h"

NAMELIST/NAMPHYOFF/ LEWBCHECK,LEWBCHECKAbort,LESNCHECK,LESNCHECKAbort,LESKTI5,& 
           & LESKTI8,LEWBSOILFIX,RDAW,LESOILCOND,LESNWBCON,LEWARMSTART,LECOLDSTART, &
           & LEROLAKE,RVDIFTS
!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUPHEC',0,ZHOOK_HANDLE)

!*         0.1    DEFINING DERIVED CONSTANTS FROM UNIVERSAL CONSTANTS
!                 ---------------------------------------------------

!1s RVTMP2=RCPV/RCPD-1.
!1s RHOH2O=RATM/100.
!1s R2ES=RESTT*RD/RV
!1s R3LES=17.269
!1s R3IES=21.875
!1s R4LES=35.86
!1s R4IES=7.66
!1s R5LES=R3LES*(RTT-R4LES)
!1s R5IES=R3IES*(RTT-R4IES)
!1s R5ALVCP=R5LES*RLVTT/RCPD
!1s R5ALSCP=R5IES*RLSTT/RCPD
!1s RALVDCP=RLVTT/RCPD
!1s RALSDCP=RLSTT/RCPD
!1s RALFDCP=RLMLT/RCPD
!1s RTWAT=RTT
!1s RTBER=RTT-5.
!1s RTICE=RTT-23.

!RVTMP2=RCPV/RCPD-1.0_JPRB   !use cp,moist
RVTMP2=0.0_JPRB              !neglect cp,moist
RHOH2O=RATM/100._JPRB
R2ES=611.21_JPRB*RD/RV
R3LES=17.502_JPRB
R3IES=22.587_JPRB
R4LES=32.19_JPRB
R4IES=-0.7_JPRB
R5LES=R3LES*(RTT-R4LES)
R5IES=R3IES*(RTT-R4IES)
R5ALVCP=R5LES*RLVTT/RCPD
R5ALSCP=R5IES*RLSTT/RCPD
RALVDCP=RLVTT/RCPD
RALSDCP=RLSTT/RCPD
RALFDCP=RLMLT/RCPD
RTWAT=RTT
RTBER=RTT-5._JPRB
RTICE=RTT-23._JPRB
! I. Hadade bug fix.
RTICECU=RTT-23._JPRB

RTWAT_RTICE_R=1.0_JPRB/(RTWAT-RTICE)
RTWAT_RTICECU_R=1.0_JPRB/(RTWAT-RTICECU)


! Albedo of permanent snow (Antarctica, Greenland) - should match the
! value in ifs/setup/su0phy.F90.  0.835 matches the value up to cycle
! 46r1.  0.8 would be in better agreement with measurements.
RALFMINPSN = 0.82_JPRB

!     ------------------------------------------------------------------

!*         1.     SETTING CONSTANTS FOR VERTICAL DIFFUSION
!                 ----------------------------------------

CALL SUVDFS

CALL SUVDF

!*         2.     SETTING CONSTANTS FOR RADIATION 
!                 -------------------------------


NCOM    = 1
NTSW   = 4
NSW    = 2
LONEWSW=.TRUE.
LCCNL  =.FALSE.
LCCNO  =.FALSE.
RCCNSEA = 0._JPRB
RCCNLND = 0._JPRB
! Number of longwave emissivity intervals
IF (NEMISSSCHEME == 1) THEN
  NLWEMISS = 6
ELSE
  NLWEMISS = 2
ENDIF
CALL SURDI
CALL SURDI1S
CALL SULWN
CALL SUSWN   (NTSW,NSW)

!     ------------------------------------------------------------------

!*         2b.     READ NAMELISTS
!                 ------------------------------------

CALL RDNML_SNOW(TMP_SURF)
CALL RDNML_SOIL(TMP_SURF)
CALL RDNML_VEG(TMP_SURF)
CALL RDNML_AGS(TMP_SURF)
CALL RDNML_FLAKE(TMP_SURF)
CALL RDNML_EXC(TMP_SURF)
CALL RDNML_URB(TMP_SURF)

!     ------------------------------------------------------------------

!*         3.     SETTING CONSTANTS FOR SURFACE SCHEME
!                 ------------------------------------
LEOCMTKE =.FALSE.
RCIMIN=0.005_JPRB

CALL SUSURF(KSW=NSW,KCSS=NCSS,KCWS=NCWS,KCSNEC=NCSNEC,KSIL=NSIL,KCOM=NCOM,KTILES=NTILES,KTSW=NTSW,KLWEMISS=NLWEMISS,&
    & KBVOC_EMIS=NBVOC_EMIS,KBVOC_DELTA_DAY_LAI=DELTA_DAY_LAI_EMIS_BVOC, &
    & LD_LEFLAKE=LEFLAKE, LD_LEURBAN=LEURBAN, LD_LEOCML=LEOCML, LD_LOCMLTKE=LEOCMTKE,&
    & LD_LWCOU=LWCOU,LD_LWCOU2W=LWCOU2W,LD_LWCOUHMF=LWCOUHMF, &
    & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,LD_LEVGEN=LEVGEN,LD_LESSRO=LESSRO,&
    & LD_LELAIV=LELAIV,LD_LECTESSEL=LECTESSEL,LD_LEAGS=LEAGS,&
    & LD_LEFARQUHAR=LEFARQUHAR, LD_LEAIRCO2COUP=LEAIRCO2COUP,&
    & LD_LESN09=LESN09,&
    & LD_LESNML=LESNML,LD_LESNICE=LESNICE,LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LEOCLA=LEOCLA,&
    & KALBEDOSCHEME=NALBEDOSCHEME,KEMISSSCHEME=NEMISSSCHEME,KFLAKEV=NFLAKEV,&
    & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,&
    & LD_LBVOC=LBVOC_EMIS, BVOC_NAMES=BVOC_NAMES, &
    & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,&
    & PRLAIINT=RLAIINT,PRSUN=RSUN,PRCORIOI=1._JPRB,PRPLRG=1._JPRB,PNSNMLWS=NSNMLWS,&
    & PRVR0VT=RVR0VT,PRVCMAX25=RVCMAX25,PRHUMREL=RHUMREL,PRA1=RA1,PRB1=RB1,PRG0=RG0,PRGM25=RGM25,&
    & PRE_VCMAX=RE_VCMAX,PRE_JMAX=RE_JMAX,&  
    & YDSURF=YDSURF,PRALFMINPSN=RALFMINPSN,PRCIMIN=RCIMIN, TMP_SURF=TMP_SURF) 

!GPB change
!CALL SUVEG

!* get back some soil parameters used elsewhere in the code
!
IF (.NOT.ALLOCATED(RDAW)) ALLOCATE(RDAW(NCSS))
CALL SURF_INQ(YDSURF,PRDAW=RDAW)
!     ------------------------------------------------------------------
WRITE(UNIT=KULOUT,FMT=*) 'PRDAW1',RDAW

!! Many "workaround" setting of surface constants skiiping susurf interface... This only works in offline mode!!! 

YSURF => GET_SURF(YDSURF)
!set defaults - defined in sussoil 
LEWBCHECK=YSURF%YSOIL%LEWBCHECK
LEWBCHECKAbort=YSURF%YSOIL%LEWBCHECKAbort
LESNCHECK=YSURF%YSOIL%LESNCHECK
LESNCHECKAbort=YSURF%YSOIL%LESNCHECKAbort
LESKTI5=YSURF%YSOIL%LESKTI5
LESKTI8=YSURF%YSOIL%LESKTI8
LESOILCOND=YSURF%YSOIL%LESOILCOND
LEWBSOILFIX=YSURF%YSOIL%LEWBSOILFIX
LESNWBCON=YSURF%YSOIL%LESNWBCON
LEWARMSTART=.FALSE.
LECOLDSTART=.FALSE.
LEROLAKE=.TRUE.
! read namelist 
REWIND(NULNAM)
READ(NULNAM,NAMPHYOFF)

! update buffer 
YSURF%YSOIL%LEWBCHECK=LEWBCHECK
YSURF%YSOIL%LEWBCHECKAbort=LEWBCHECKAbort
YSURF%YSOIL%LESNCHECK=LESNCHECK
YSURF%YSOIL%LESNCHECKAbort=LESNCHECKAbort
YSURF%YSOIL%LESKTI5=LESKTI5
YSURF%YSOIL%LESKTI8=LESKTI8
YSURF%YSOIL%LEWBSOILFIX=LEWBSOILFIX
YSURF%YSOIL%LESOILCOND=LESOILCOND
YSURF%YSOIL%LESNWBCON=LESNWBCON
YSURF%YSOIL%LEROLAKE=LEROLAKE
!YSURF%YSOIL%LEWARMSTART=LEWARMSTART
!YSURF%YSOIL%LECOLDSTART=LECOLDSTART
DO I=1,NCSS
  YSURF%YSOIL%RDAT(I) = RDAW(I)
  YSURF%YSOIL%RDAW(I) = RDAW(I)
  YSURF%YSOIL%RDAI(I) = RDAW(I)
ENDDO

CALL SURF_INQ(YDSURF,PRDAW=RDAW)
WRITE(UNIT=KULOUT,FMT=*) 'PRDAW2',RDAW
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LEWBCHECK  = '',L5)') YSURF%YSOIL%LEWBCHECK
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LEWBCHECKAbort  = '',L5)') YSURF%YSOIL%LEWBCHECKAbort
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LESNCHECK  = '',L5)') YSURF%YSOIL%LESNCHECK
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LESNCHECKAbort  = '',L5)') YSURF%YSOIL%LESNCHECKAbort
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LESKTI5  = '',L5)') YSURF%YSOIL%LESKTI5
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LESKTI8  = '',L5)') YSURF%YSOIL%LESKTI8
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LEWBSOILFIX  = '',L5)') YSURF%YSOIL%LEWBSOILFIX
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LESOILCOND  = '',L5)') YSURF%YSOIL%LESOILCOND
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LESNWBCON  = '',L5)') YSURF%YSOIL%LESNWBCON
WRITE(UNIT=KULOUT,FMT='('' YSURF%YSOIL%LEROLAKE  = '',L5)') YSURF%YSOIL%LEROLAKE
WRITE(UNIT=KULOUT,FMT=*) 'RVDIFTS = ',RVDIFTS
WRITE(UNIT=KULOUT,FMT=*) 'NCSS,NCWS = ',NCSS,NCWS
WRITE(UNIT=KULOUT,FMT='('' SUPHEC IS OVER '')')

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUPHEC',1,ZHOOK_HANDLE)

CALL MPL_BARRIER()

RETURN
END SUBROUTINE SUPHEC
